{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit VisualUtils;

interface

uses
  LCLProc, Menus, LCLType, SysUtils, Windows, Classes, Graphics, ComCtrls,
  Math, Forms, MiscUtils, Controls, ActnList, Dialogs, CommCtrl, Clipbrd,
  StdCtrls, ImgList, Spin;

type
  {$INTERFACES CORBA}
  IMouseListener = interface
    ['2b40ae480b66ef88']
    procedure NotifyMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure NotifyMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure NotifyMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  end;
  {$INTERFACES DEFAULT}
  TMouseListenerList = TGenericList<IMouseListener>;

  {$INTERFACES CORBA}
  ICloseQueryListener = interface
    ['c182fac8e5e6920b']
    function CanClose: Boolean;
  end;
  {$INTERFACES DEFAULT}

  TFrameClass = class of TFrame;

procedure InitializeProgram;
function SetWaitCursor: TCursor;
function GetWindowWithProperty(const PropertyName: String): HWND;
procedure OpenWithShell(const Location: String);

procedure TrySetFocus(WinControl: TWinControl);
function ContainsActiveFormControl(Control: TWinControl): Boolean;
procedure DeselectChildren(Control: TWinControl);
procedure SelectFirstChild(Parent: TWinControl);

function GetAncestorOfType(Control: TControl; AncestorClass: TWinControlClass): TWinControl;
function FindParentForm(Control: TControl): TCustomForm;
function HasVisibleChildControls(Parent: TWinControl): Boolean;
procedure ShowAlignedControlReliably(Control: TControl);

procedure SaveFormPosition(Form: TForm);
function RestoreFormPosition(Form: TForm): Boolean;
function ShowModalForm(Form: TForm): Integer;

procedure MakeVerticallyAutoScrollable(ScrollBox: TScrollBox);
procedure ScrollControlPartIntoView(Control: TControl; PartTop, PartHeight: Integer);
procedure ScrollControlIntoView(Control: TControl);
function IsVerticalScrollBarVisible(Control: TScrollingWinControl): Boolean;
function ScrollVerticallyByWheel(Control: TScrollingWinControl; WheelDelta: Integer): Integer;
function DragScrollVertically(Control: TControl): Integer;

procedure LockRedraw(Control: TWinControl);
procedure UnlockRedraw(Control: TWinControl);

procedure LoadActionImages(ActionList: TActionList);
function AddPngResourceToImageList(const ResourceName: String; ImageList: TCustomImageList): Integer;
procedure LoadPngResourceToPicture(const ResourceName: String; Target: TPicture);
procedure LoadPngResourceToBitmap(const ResourceName: String; Target: TBitmap);

procedure SetFixedWidthConstraint(Control: TControl; Width: Integer);
procedure SetFixedHeightConstraint(Control: TControl; Height: Integer);
procedure SetFixedSizeConstraints(Control: TControl; Width, Height: Integer);
function GetPreferredControlSize(Control: TControl): TSize;
procedure SetFontSize(const Controls: array of TControl; FontSize: Integer);
procedure SetFontColor(const Controls: array of TControl; FontColor: TColor);
procedure StretchToWidest(const Controls: array of TControl);
procedure SetRightBorderSpacing(const Controls: array of TControl; LogicalPixels: Integer);
function GetMaxPreferredSize(const Controls: array of TControl): TSize;
procedure IncreaseMinHeight(const Controls: array of TControl; Pixels: Integer);

function MaxSize(const a, b: TSize): TSize;
function ScalePixels(Value: Integer): Integer;

procedure SetClipboardMarkerFormat(const FormatName: String);
function ClipboardHasFormatName(const FormatName: String): Boolean;

function AddMenuItemForAction(Action: TAction; ParentItem: TMenuItem): TMenuItem;
procedure AppendMenuShortcutsToActionHints(Menu: TMenu);
procedure AppendMenuItemShortcutsToActionHints(MenuItem: TMenuItem);

procedure SetCheckBoxStateWithoutOnClick(CheckBox: TCheckBox; Checked: Boolean);
procedure SetRadioButtonStateWithoutOnClick(RadioButton: TRadioButton; Checked: Boolean);
procedure SetEditTextWithoutOnChange(Edit: TEdit; const Text: String);

procedure SetEditError(Edit: TEdit);
procedure ResetEditError(Edit: TEdit);
procedure SetEditColor(Edit: TEdit; Color: TColor);
procedure SetEditWidthByMaxLength(Edit: TEdit);
procedure SetEditWidthsByMaxLength(const Edits: array of TEdit);
procedure SetSpinEditWidthAndMaxLengthByMaxValue(SpinEdit: TSpinEdit);

procedure DisplayListViewSortIndicator(ListView: TListView; ColumnIndex: Integer; SortBackwards: Boolean);
procedure MakeListViewDoubleBuffered(ListView: TListView);
procedure SelectAllListViewItems(ListView: TListView);
function GetListViewLastSelectedItem(ListView: TListView): TListItem;
function ListViewHasSelection(ListView: TListView): Boolean;
function GetPreferredListViewHeight(ListView: TListView; ItemCount: Integer): Integer;
procedure AutoSizeListViewColumn(ListView: TListView; ColumnIndex: Integer);
procedure AutoSizeListViewColumns(ListView: TListView);
procedure SetListViewItemCount(ListView: TListView; ItemCount: Integer;
  SubitemCount: Integer = 0);

procedure ClearTreeViewAndFreeDataObjects(TreeView: TTreeView);

procedure ConstrainMinPageSizeToLargest(PageControl: TPageControl);
procedure RemoveMinPageSizeConstraints(PageControl: TPageControl);

implementation

type
  TSavedFormPosition = class
  private
    FFormClass: TFormClass;
    FWasMaximized: Boolean;
    FLastBoundsRect: TRect;
  end;
  TSavedFormPositionList = TGenericObjectList<TSavedFormPosition>;

var
  SavedFormPositions: TSavedFormPositionList;

procedure ConstrainMinPageSizeToLargest(PageControl: TPageControl);
var
  Pages: array of TControl;
  i: Integer;
  s: TSize;
  Page: TControl;
begin
  SetLength(Pages, PageControl.PageCount);
  for i := 0 to High(Pages) do
    Pages[i] := PageControl.Pages[i];

  s := GetMaxPreferredSize(Pages);

  for Page in Pages do
  begin
    Page.Constraints.MinWidth := s.cx;
    Page.Constraints.MinHeight := s.cy;
  end;
end;

procedure RemoveMinPageSizeConstraints(PageControl: TPageControl);
var
  i: Integer;
begin
  for i := 0 to PageControl.PageCount-1 do
  begin
    PageControl.Pages[i].Constraints.MinWidth := 0;
    PageControl.Pages[i].Constraints.MinHeight := 0;
  end;
end;

function GetMaxPreferredSize(const Controls: array of TControl): TSize;
var
  c: TControl;
begin
  Result.cx := 0;
  Result.cy := 0;
  for c in Controls do
    Result := MaxSize(Result, GetPreferredControlSize(c));
end;

function MaxSize(const a, b: TSize): TSize;
begin
  Result.cx := Max(a.cx, b.cx);
  Result.cy := Max(a.cy, b.cy);
end;

procedure SelectAllListViewItems(ListView: TListView);
var
  Item: TListItem;
begin
  for Item in ListView.Items do
    Item.Selected := TRUE;
end;

procedure ClearTreeViewAndFreeDataObjects(TreeView: TTreeView);
var
  Node: TTreeNode;
begin
  Node := TreeView.Items.GetFirstNode;
  while Node <> nil do
  begin
    TObject(Node.Data).Free;
    Node := Node.GetNext;
  end;
  TreeView.Items.Clear;
end;

procedure TrySetFocus(WinControl: TWinControl);
begin
  try
    WinControl.SetFocus;
  except
  end;
end;

procedure SetCheckBoxStateWithoutOnClick(CheckBox: TCheckBox; Checked: Boolean);
var
  SavedHandler: TNotifyEvent;
begin
  SavedHandler := CheckBox.OnClick;
  CheckBox.OnClick := nil;
  try
    CheckBox.Checked := Checked;
  finally
    CheckBox.OnClick := SavedHandler;
  end;
end;

procedure SetRadioButtonStateWithoutOnClick(RadioButton: TRadioButton;
  Checked: Boolean);
var
  SavedHandler: TNotifyEvent;
begin
  SavedHandler := RadioButton.OnClick;
  RadioButton.OnClick := nil;
  try
    RadioButton.Checked := Checked;
  finally
    RadioButton.OnClick := SavedHandler;
  end;
end;

function GetSavedFormPosition(FormClass: TFormClass): TSavedFormPosition;
begin
  if SavedFormPositions <> nil then
    for Result in SavedFormPositions do
      if Result.FFormClass = FormClass then
        Exit;
  Result := nil;
end;

procedure SetEditTextWithoutOnChange(Edit: TEdit; const Text: String);
var
  SavedHandler: TNotifyEvent;
begin
  SavedHandler := Edit.OnChange;
  Edit.OnChange := nil;
  try
    Edit.Text := Text;
  finally
    Edit.OnChange := SavedHandler;
  end;
end;

procedure SetEditError(Edit: TEdit);
begin
  LockRedraw(Edit);
  try
    Edit.Color := $aaaaff;
    Edit.Font.Color := $000000;
  finally
    UnlockRedraw(Edit);
  end;
end;

procedure ResetEditError(Edit: TEdit);
begin
  LockRedraw(Edit);
  try
    Edit.Color := clDefault;
    Edit.ParentFont := TRUE;
  finally
    UnlockRedraw(Edit);
  end;
end;

procedure SetEditColor(Edit: TEdit; Color: TColor);
begin
  LockRedraw(Edit);
  try
    Edit.Color := Color;
  finally
    UnlockRedraw(Edit);
  end;
end;

procedure SetEditWidthByMaxLength(Edit: TEdit);
{ Edit must have the same font as its parent form for this to work. }
var
  Form: TCustomForm;
  w: Integer;
begin
  Form := GetParentForm(Edit);
  Assert( Form <> nil );
  w := Form.Canvas.TextWidth(StringOfChar('0', Edit.MaxLength + 3));
  Edit.Width := w;
  SetFixedWidthConstraint(Edit, w);
end;

procedure SetEditWidthsByMaxLength(const Edits: array of TEdit);
var
  e: TEdit;
begin
  for e in Edits do
    SetEditWidthByMaxLength(e);
end;

procedure SetSpinEditWidthAndMaxLengthByMaxValue(SpinEdit: TSpinEdit);
{ SpinEdit must have the same font as its parent form for this to work. }
var
  Form: TCustomForm;
  MaxDigits, Width: Integer;
begin
  Form := GetParentForm(SpinEdit);
  Assert( Form <> nil );
  MaxDigits := Length(IntToStr(SpinEdit.MaxValue));
  SpinEdit.MaxLength := MaxDigits;
  Width := Form.Canvas.TextWidth(StringOfChar('0', MaxDigits + 6));
  SpinEdit.Width := Width;
  SetFixedWidthConstraint(SpinEdit, Width);
end;

procedure SaveFormPosition(Form: TForm);
var
  p: TSavedFormPosition;
begin
  p := GetSavedFormPosition(TFormClass(Form.ClassType));
  if p = nil then
  begin
    if SavedFormPositions = nil then
      SavedFormPositions := TSavedFormPositionList.Create;
    p := SavedFormPositions.AddSafely(TSavedFormPosition.Create);
  end;

  p.FFormClass := TFormClass(Form.ClassType);
  p.FWasMaximized := Form.WindowState = wsMaximized;
  if p.FWasMaximized then
    p.FLastBoundsRect := Rect(0, 0, 0, 0)
  else
    p.FLastBoundsRect := Form.BoundsRect;
end;

function RestoreFormPosition(Form: TForm): Boolean;
var
  p: TSavedFormPosition;
begin
  p := GetSavedFormPosition(TFormClass(Form.ClassType));
  Result := p <> nil;
  if Result then
  begin
    if p.FWasMaximized then
    begin
      Form.Position := poDefaultPosOnly;
      Form.WindowState := wsMaximized;
    end
    else
    begin
      Form.Position := poDesigned;
      if Form.BorderStyle in [bsSizeable, bsSizeToolWin] then
        Form.BoundsRect := p.FLastBoundsRect
      else
      begin
        Form.Top := p.FLastBoundsRect.Top;
        Form.Left := p.FLastBoundsRect.Left;
      end;
    end;
  end;
end;

function ShowModalForm(Form: TForm): Integer;
begin
  Result := Form.ShowModal;
  SaveFormPosition(Form);
end;

procedure AutoSizeListViewColumn(ListView: TListView; ColumnIndex: Integer);
var
  w, i: Integer;
begin
  w := 0;
  for i := 0 to ListView.Columns.Count-1 do
  begin
    if i <> ColumnIndex then
      Inc(w, ListView.Columns[i].Width);
  end;
  ListView.Columns[ColumnIndex].Width := Max(
    ListView.Width - GetSystemMetrics(SM_CXVSCROLL) - 2*GetSystemMetrics(SM_CXEDGE) - w,
    ListView.Columns[ColumnIndex].MinWidth
  );
end;

procedure AutoSizeListViewColumns(ListView: TListView);
var
  i, w, Padding: Integer;
  c: TListColumn;
begin
  ListView.Columns.Add; { Create a temporary column to prevent the rightmost
    of the existing columns from occupying the entire remaining width. }
  try
    Padding := ListView.Canvas.TextWidth(StringOfChar('_', 6));
    for i := 0 to ListView.Columns.Count-2 do
    begin
      c := ListView.Columns[i];
      c.AutoSize := TRUE;
      w := c.Width;
      c.AutoSize := FALSE;
      c.Width := w + Padding;
    end;
  finally
    ListView.Columns.Delete(ListView.Columns.Count-1);
  end;
end;

procedure SetListViewItemCount(ListView: TListView; ItemCount: Integer;
  SubitemCount: Integer = 0);
var
  i, j: Integer;
  Item: TListItem;
begin
  for i := ListView.Items.Count-1 downto ItemCount do
    ListView.Items.Delete(i);

  for i := 1 to ItemCount - ListView.Items.Count do
  begin
    Item := ListView.Items.Add;
    for j := 1 to SubitemCount do
      Item.SubItems.Add('');
  end;
end;

function GetAncestorOfType(Control: TControl; AncestorClass: TWinControlClass): TWinControl;
begin
  Result := Control.Parent;
  while (Result <> nil) and not (Result is AncestorClass) do
    Result := Result.Parent;
end;

type
  TScrollHelper = class
    class procedure ScrollBoxResize(Sender: TObject);
    class procedure ScrollBoxMouseWheel(Sender: TObject;
      Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
      var Handled: Boolean);
    class procedure ContentResize(Sender: TObject);
  end;

procedure EnsureScrollPositionCorrect(ScrollBar: TControlScrollBar);
begin
  if ScrollBar.Page >= ScrollBar.Range then
    ScrollBar.Position := 0;
end;

class procedure TScrollHelper.ScrollBoxResize(Sender: TObject);
var
  s: TScrollBox;
  c: TControl;
begin
  s := Sender as TScrollBox;
  if s.ControlCount = 1 then
  begin
    c := s.Controls[0];
    c.Constraints.MaxWidth := Max(s.Width - GetSystemMetrics(SM_CXVSCROLL), 0);
    s.VertScrollBar.Page := s.ClientHeight;
    EnsureScrollPositionCorrect(s.VertScrollBar);
  end;
end;

class procedure TScrollHelper.ScrollBoxMouseWheel(Sender: TObject;
  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
  var Handled: Boolean);
begin
  ScrollVerticallyByWheel((Sender as TScrollBox), WheelDelta);
  Handled := TRUE;
end;

class procedure TScrollHelper.ContentResize(Sender: TObject);
var
  s: TScrollBox;
  c: TControl;
begin
  c := Sender as TControl;
  if (c.Parent is TScrollBox) and (c.Parent.ControlCount = 1) then
  begin
    s := TScrollBox(c.Parent);
    s.VertScrollBar.Range := c.Height;
    EnsureScrollPositionCorrect(s.VertScrollBar);
  end;
end;

procedure MakeVerticallyAutoScrollable(ScrollBox: TScrollBox);
var
  c: TControl;
begin
  Assert( not ScrollBox.AutoScroll );
  Assert( not Assigned(ScrollBox.OnChangeBounds) );
  Assert( ScrollBox.ControlCount = 1 );
  c := ScrollBox.Controls[0];
  Assert( not Assigned(c.OnResize) );

  ScrollBox.OnChangeBounds := TScrollHelper.ScrollBoxResize;
  ScrollBox.VertScrollBar.Tracking := TRUE;
  c.OnResize := TScrollHelper.ContentResize;

  TScrollHelper.ScrollBoxResize(ScrollBox);

  if not Assigned(ScrollBox.OnMouseWheel) then
    ScrollBox.OnMouseWheel := TScrollHelper.ScrollBoxMouseWheel;
end;

procedure ScrollControlPartIntoView(Control: TControl; PartTop,
  PartHeight: Integer);
var
  s: TScrollingWinControl;
  y1, y2, t: Integer;
  InView: Boolean;
begin
  s := TScrollingWinControl(GetAncestorOfType(Control, TScrollBox));
  if s <> nil then
  begin
    y1 := s.VertScrollBar.Position;
    y2 := y1 + s.ClientHeight;
    t := s.ScreenToClient(Control.ControlOrigin).y + PartTop;

    InView := (t >= y1) and ((t + PartHeight) <= y2);
    if not InView then
      s.VertScrollBar.Position := t - (s.ClientHeight - PartHeight) div 2;
  end;
end;

procedure ScrollControlIntoView(Control: TControl);
begin
  ScrollControlPartIntoView(Control, 0, Control.Height);
end;

procedure LockRedraw(Control: TWinControl);
begin
  SendMessage(Control.Handle, WM_SETREDRAW, 0, 0);
end;

procedure UnlockRedraw(Control: TWinControl);
begin
  SendMessage(Control.Handle, WM_SETREDRAW, 1, 0);
  Control.Invalidate;
end;

function FindParentForm(Control: TControl): TCustomForm;
begin
  Result := GetParentForm(Control);
  if Result = nil then
    raise Exception.CreateFmt('Control "%s" ("%s") does not have a parent form.', [Control.ClassName, Control.Name]);
end;

function LoadPngResource(const ResourceName: String): TPortableNetworkGraphic;
var
  Stream: TResourceStream;
begin
  Result := TPortableNetworkGraphic.Create;
  try
    Stream := TResourceStream.Create(HINSTANCE, ResourceName, RT_RCDATA);
    try
      Result.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
  except
    Result.Free;
    raise;
  end;
end;

procedure LoadActionImages(ActionList: TActionList);
var
  a: TContainedAction;
  Action: TAction;
begin
  for a in ActionList do
  begin
    Action := a as TAction;
    if Action.HelpKeyword <> '' then
      Action.ImageIndex := AddPngResourceToImageList(Action.HelpKeyword, ActionList.Images);
  end;
end;

function AddPngResourceToImageList(const ResourceName: String; ImageList: TCustomImageList): Integer;
var
  Png: TPortableNetworkGraphic;
begin
  Png := LoadPngResource(ResourceName);
  try
    Result := ImageList.Add(Png, nil);
  finally
    Png.Free;
  end;
end;

procedure LoadPngResourceToPicture(const ResourceName: String; Target: TPicture);
var
  Png: TPortableNetworkGraphic;
begin
  Png := LoadPngResource(ResourceName);
  try
    Target.Graphic := Png;
  finally
    Png.Free;
  end;
end;

procedure LoadPngResourceToBitmap(const ResourceName: String; Target: TBitmap);
var
  Png: TPortableNetworkGraphic;
begin
  Png := LoadPngResource(ResourceName);
  try
    Target.Assign(Png);
  finally
    Png.Free;
  end;
end;

function ContainsActiveFormControl(Control: TWinControl): Boolean;
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Control);
  Result := (Form <> nil) and Control.ContainsControl(Form.ActiveControl);
end;

procedure DeselectChildren(Control: TWinControl);
begin
  if ContainsActiveFormControl(Control) then
    FindParentForm(Control).ActiveControl := Control;
end;

procedure InitializeProgram;
begin
  Application.HintHidePause := 120000;
  Application.HintHidePausePerChar := 0;
  Application.UpdateFormatSettings := FALSE;
  FormatSettings.DecimalSeparator := '.';
  FormatSettings.ThousandSeparator := ' ';
end;

function SetWaitCursor: TCursor;
begin
  Result := Screen.Cursor;
  Screen.Cursor := crHourGlass;
end;

type
  TPropertySearch = record
    PropertyName: String;
    WindowHandle: HWND;
  end;
  PPropertySearch = ^TPropertySearch;

function GetWindowWithPropertyCallback(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
  Search: PPropertySearch;
begin
  {$HINTS OFF}
  Search := PPropertySearch(lParam);
  {$HINTS ON}
  if GetProp(hwnd, PChar(Search.PropertyName)) <> 0 then
  begin
    Search.WindowHandle := hwnd;
    Result := FALSE;
  end
  else
    Result := TRUE;
end;

function GetWindowWithProperty(const PropertyName: String): HWND;
var
  Search: TPropertySearch;
begin
  Search.PropertyName := PropertyName;
  Search.WindowHandle := 0;
  {$HINTS OFF}
  EnumWindows(@GetWindowWithPropertyCallback, LPARAM(@Search));
  {$HINTS ON}
  Result := Search.WindowHandle;
end;

procedure OpenWithShell(const Location: String);
var
  SavedCursor: TCursor;
  s: UnicodeString;
begin
  SavedCursor := SetWaitCursor;
  try
    s := UTF8Decode(Location);
    ShellExecuteW(0, 'open', PWideChar(s), nil, nil, SW_SHOW);
  finally
    Screen.Cursor := SavedCursor;
  end;
end;

procedure SetFixedWidthConstraint(Control: TControl; Width: Integer);
begin
  Control.Constraints.MinWidth := Width;
  Control.Constraints.MaxWidth := Width;
end;

procedure SetFixedHeightConstraint(Control: TControl; Height: Integer);
begin
  Control.Constraints.MinHeight := Height;
  Control.Constraints.MaxHeight := Height;
end;

procedure SetFixedSizeConstraints(Control: TControl; Width, Height: Integer);
begin
  SetFixedWidthConstraint(Control, Width);
  SetFixedHeightConstraint(Control, Height);
end;

type
  THackedWinControl = class(TWinControl) end;

procedure SelectFirstChild(Parent: TWinControl);
begin
  THackedWinControl(Parent).SelectFirst;
end;

function DragScrollVertically(Control: TControl): Integer;
{ Returns amount scrolled in pixels. }
var
  p: TPoint;
  Scrollable: TScrollingWinControl;
  d, t, y1, ScrollableScreenTop, ScrollableScreenBottom, OldPosition: Integer;
begin
  Scrollable := TScrollingWinControl(GetAncestorOfType(Control, TScrollBox));
  {$HINTS OFF}
  if (Scrollable <> nil) and GetCursorPos(p) then
  {$HINTS ON}
  begin
    ScrollableScreenTop := Scrollable.ControlOrigin.y;
    ScrollableScreenBottom := ScrollableScreenTop + Scrollable.Height;
    y1 := Scrollable.VertScrollBar.Position;
    t := Scrollable.ScreenToClient(Control.ControlOrigin).y;

    if (t < y1) and (p.y < ScrollableScreenTop) then
      d := p.y - ScrollableScreenTop
    else if ((t + Control.Height) > (y1 + Scrollable.ClientHeight)) and (p.y > ScrollableScreenBottom) then
      d := p.y - ScrollableScreenBottom
    else
      d := 0;

    if d = 0 then
      Result := 0
    else
    begin
      OldPosition := Scrollable.VertScrollBar.Position;
      Scrollable.VertScrollBar.Position := Scrollable.VertScrollBar.Position
        + Sign(d) * Min(Abs(d), 80);
      Result := Scrollable.VertScrollBar.Position - OldPosition;
    end;
  end
  else
    Result := 0;
end;

function GetPreferredControlSize(Control: TControl): TSize;
begin
  Result.cx := 0;
  Result.cy := 0;
  Control.GetPreferredSize(Result.cx, Result.cy);
end;

function ScalePixels(Value: Integer): Integer;
begin
  Result := ScaleX(Value, 96);
end;

procedure SetFontSize(const Controls: array of TControl; FontSize: Integer);
var
  c: TControl;
begin
  for c in Controls do
    c.Font.Size := FontSize;
end;

procedure SetFontColor(const Controls: array of TControl; FontColor: TColor);
var
  c: TControl;
begin
  for c in Controls do
    c.Font.Color := FontColor;
end;

procedure StretchToWidest(const Controls: array of TControl);
var
  w: Integer;
  c: TControl;
begin
  w := 0;
  for c in Controls do
    w := Max(w, GetPreferredControlSize(c).cx);
  for c in Controls do
    SetFixedWidthConstraint(c, w);
end;

procedure SetRightBorderSpacing(const Controls: array of TControl;
  LogicalPixels: Integer);
var
  c: TControl;
  p: Integer;
begin
  p := ScalePixels(LogicalPixels);
  for c in Controls do
    c.BorderSpacing.Right := p;
end;

function HasVisibleChildControls(Parent: TWinControl): Boolean;
var
  i: Integer;
begin
  Result := FALSE;
  for i := 0 to Parent.ControlCount-1 do
    if Parent.Controls[i].Visible then
    begin
      Result := TRUE;
      Break;
    end;
end;

procedure ShowAlignedControlReliably(Control: TControl);
var
  AdjustAlign: Boolean;
  r: TRect;
begin
  if not Control.Visible then
  begin
    AdjustAlign := Control.Align = alClient;
    if AdjustAlign then
    begin
      r := Control.BoundsRect;
      Control.Align := alNone;
      Control.BoundsRect := r;
    end;

    Control.Visible := TRUE;

    if AdjustAlign then
      Control.Align := alClient;
  end;
end;

procedure DisplayListViewSortIndicator(ListView: TListView; ColumnIndex: Integer;
  SortBackwards: Boolean);
var
  i: Integer;
  h: HWND;
  Item: HDITEM;
begin
  h := ListView_GetHeader(ListView.Handle);
  for i := 0 to ListView.Columns.Count-1 do
  begin
    {$HINTS OFF}
    FillChar(Item, SizeOf(Item), 0);
    {$HINTS ON}
    Item.mask := HDI_FORMAT;
    Header_GetItem(h, i, Item);
    Item.fmt := Item.fmt and not (HDF_SORTUP or HDF_SORTDOWN);
    if i = ColumnIndex then
    begin
      if SortBackwards then
        Item.fmt := Item.fmt or HDF_SORTDOWN
      else
        Item.fmt := Item.fmt or HDF_SORTUP;
    end;
    Header_SetItem(h, i, Item);
  end;
end;

procedure MakeListViewDoubleBuffered(ListView: TListView);
begin
  ListView_SetExtendedListViewStyleEx(ListView.Handle,
    LVS_EX_DOUBLEBUFFER, LVS_EX_DOUBLEBUFFER);
end;

function GetListViewLastSelectedItem(ListView: TListView): TListItem;
var
  i: Integer;
begin
  Result := nil;
  for i := ListView.Items.Count-1 downto 0 do
    if ListView.Items[i].Selected then
    begin
      Result := ListView.Items[i];
      Break;
    end;
end;

function ListViewHasSelection(ListView: TListView): Boolean;
begin
  Result := ListView.Selected <> nil;
end;

function GetPreferredListViewHeight(ListView: TListView; ItemCount: Integer): Integer;
begin
  {$WARNINGS OFF}
  Result := hi(ListView_ApproximateViewRect(ListView.Handle, -1, -1, ItemCount));
  {$WARNINGS ON}
end;

function IsVerticalScrollBarVisible(Control: TScrollingWinControl): Boolean;
begin
  Result := GetWindowLong(Control.Handle, GWL_STYLE) and WS_VSCROLL <> 0;
end;

function ScrollVerticallyByWheel(Control: TScrollingWinControl;
  WheelDelta: Integer): Integer;
{ Returns amount scrolled in pixels. }
var
  Old: Integer;
begin
  if IsVerticalScrollBarVisible(Control) then
  begin
    Old := Control.VertScrollBar.Position;
    Control.VertScrollBar.Position := Old - WheelDelta div 4;
    Result := Control.VertScrollBar.Position - Old;
  end
  else
    Result := 0;
end;

procedure SetClipboardMarkerFormat(const FormatName: String);
var
  Zero: Byte = 0;
begin
  Clipboard.Open;
  try
    Clipboard.Clear;
    Clipboard.AddFormat(RegisterClipboardFormat(FormatName), Zero, SizeOf(Zero));
  finally
    Clipboard.Close;
  end;
end;

function ClipboardHasFormatName(const FormatName: String): Boolean;
begin
  Result := Clipboard.HasFormat(RegisterClipboardFormat(FormatName));
end;

function AddMenuItemForAction(Action: TAction; ParentItem: TMenuItem): TMenuItem;
begin
  Result := TMenuItem.Create(nil);
  try
    Result.Action := Action;
    ParentItem.Add(Result);
  except
    Result.Free;
    raise;
  end;
end;

procedure AppendMenuShortcutsToActionHints(Menu: TMenu);
begin
  AppendMenuItemShortcutsToActionHints(Menu.Items);
end;

procedure AppendMenuItemShortcutsToActionHints(MenuItem: TMenuItem);
var
  mi: TMenuItem;
  a: TAction;
begin
  for mi in MenuItem do
    if (mi.ShortCut <> 0) and (mi.Action is TAction) then
    begin
      a := TAction(mi.Action);
      if a.ShortCut = 0 then
        a.Hint := Format('%s (%s)', [a.Hint, ShortCutToText(mi.ShortCut)]);
    end;
end;

procedure IncreaseMinHeight(const Controls: array of TControl; Pixels: Integer);
var
  c: TControl;
begin
  for c in Controls do
    c.Constraints.MinHeight := GetPreferredControlSize(c).cy + Pixels;
end;

finalization

  FreeAndNil(SavedFormPositions);

end.
